\ Print installed ActiveX Controls
\ Tom Dixon
\ 9/30/2008

include FCOMbase.bld

also FCOM

AliasedExtern: fOleRegGetUserType int "PASCAL" OleRegGetUserType( 
   void * clsid, DWORD dwFormOfType, LPSTR pszUserType 
);

AliasedExtern: fProgIDFromCLSID int "PASCAL" ProgIDFromCLSID( 
   void * pclsid, void * lpszProgID 
);

\ define some guids
UUID StdComponentCategoriesMgr  {0002E005-0000-0000-C000-000000000046}
UUID AXControl                  {40FC6ED4-2438-11cf-A3DB-080036F12502}

\ I couldn't find a typelibrary for these interfaces, so I must statically
\ define them.  There are only two, so it's not bad.

IUnknown Interface ICatInformation {0002E013-0000-0000-C000-000000000046}
ICatInformation Open-Interface
  3 3  IMethod EnumCategories ( *ppenumCategoryInfo lcid -- hres )
  4 4  IMethod GetCategoryDesc ( *pszDesc lcid rcatid -- hres )
  6 5  IMethod EnumClassesOfCategories ( *ppenumClsid rgcatidReq cReq rgcatidImpl cImp -- hres )
  6 6  IMethod IsClassOfCategories ( rgcatidReq cReq rgcatidImpl n clsid -- hres )
  3 7  IMethod EnumImplCategoriesOfClass ( *ppenumCatid rclsid -- hres )
  3 8  IMethod EnumReqCategoriesOfClass ( *ppenumCatid clsid -- hres )
Close-Interface

IUnknown Interface IEnumGUID {0002E000-0000-0000-C000-000000000046}
IEnumGUID Open-Interface
  4 3  IMethod Next ( *n *rgelt celt -- hres )
  2 4  IMethod Skip ( *celt -- hres )
  1 5  IMethod Reset ( -- hres )
  2 6  IMethod Clone ( *ppenum -- hres )
Close-Interface

\ structure
276 StructType CATEGORYINFO  CATEGORYINFO open-struct
  0    field: catid
  16   field: lcid
  20   field: desc
close-struct


\ Make a few interfaces
ICatInformation comiface catinfo
IEnumGUID       comiface enumc
IEnumGUID       comiface enumg

CategoryInfo    struct   catdesc

create tempguid   16  allot \ temporary guid buffer
create tempprogid 256 allot \ temporary unistring buffer

: .guids ( -- ) 
   enumg reset drop
   begin 0 tempguid 1 enumg next 0= while
     tempguid CLSID>Str unitype ."   "
     tempprogid tempguid fProgIDFromCLSID
     if s" " else tempprogid @ zunicount then
     dup >r unitype 40 r> 2/ - 1 max spaces
     pad 1 tempguid fOleRegGetUserType 0= if 
       pad @ zunicount unitype 
     then
     cr
   repeat ;
   
: .category ( -- )
   cr ." Listing " catdesc desc zunicount unitype ." :" cr
   enumg pad 0 catdesc catid 1 catinfo EnumClassesOfCategories drop
   .guids
   enumg IReleaseref drop ;
   
: .RegCOMStuff ( -- )
   ." Listing all Installed COM and ActiveX stuff:" cr
   ." CLSID                                   ProgID                                  Description" cr
   ." ======================================  =====================================   ==============" cr
   catinfo ICatInformation 1 0 StdComponentCategoriesMgr fCoCreateInstance
   abort" Unable to initialize Control Manager!"
   enumc 0 catinfo EnumCategories
   abort" Unable to enumerate categories!"
   begin 0 catdesc 1 enumc next 0= while
     .category
   repeat
   enumc IReleaseRef drop
   catinfo IReleaseRef drop ;

previous

cr .( Type .RegCOMStuff to see a list of installed COM components and ActiveX controls.) cr
